home *** CD-ROM | disk | FTP | other *** search
/ The Business Master (3rd Edition) / The Business Master (3rd Edition).iso / files / wordmisc / banner / fontsy.bas < prev    next >
Encoding:
BASIC Source File  |  1986-09-06  |  10.6 KB  |  474 lines
  1. 'FONTSY.BAS version 2.1  (C) Copyright 1985, 1986 by Merlin R. Null
  2. 'MS-DOS version.  9/6/86  Requires QuickBASIC v. 2.0, (C) Microsoft,
  3. 'to compile, and must be linked with the assembly language routines in
  4. 'FSY.ASM.  Banner printing program.  Requires external fonts encoded with
  5. 'FONTCODE.  This program may not be sold separately or as part of any
  6. 'collection of programs or used as an inducement to buy any other
  7. 'product or program without the written permission of the author:
  8. 'Merlin R. Null, P.O. Box 9422, N. Hollywood, CA 91609, (818) 762-1429
  9.  
  10.     DEFINT A-Z
  11.     DIM FontChar$(95)
  12.     ON ERROR GOTO ErrorTrap
  13.     WIDTH LPRINT 255
  14.     COLOR 11,0
  15.     IF LEN(COMMAND$)>0 THEN
  16.       Font$=COMMAND$
  17.       CALL    DoTitle
  18.     ELSE
  19. FontScreen:         'enter font screen
  20.       CALL    DoTitle
  21.       CALL    FontScr
  22.       IF ErrorMes$<>"" THEN
  23.         LOCATE 22,40-(LEN(ErrorMes$)/2)
  24.         COLOR 12,0
  25.         PRINT ErrorMes$;
  26.         COLOR 11,0
  27.         ErrorMes$=""
  28.         BEEP
  29.       END IF
  30. EnterFont:        'here after directory call
  31.       CALL    FontPrompt
  32.       LOCATE 24,28,1
  33.       LINE INPUT;Font$
  34.       IF Font$="" THEN
  35.         GOTO FontScreen
  36.       END IF
  37.       FontLen$=""
  38.       IF RIGHT$(Font$,1)=":" OR RIGHT$(Font$,1)="\" THEN
  39.         CLS
  40.         Dir$=Font$+"*.FNT"
  41.         LOCATE 1,20
  42. 400         FILES Dir$
  43.         LOCATE 1,1
  44.         PRINT"Available fonts on ";
  45.         GOTO EnterFont
  46.       END IF
  47.     END IF
  48.     IF INSTR(Font$,".")=0 THEN
  49.       Font$=Font$+".FNT"
  50.     END IF
  51. 500    OPEN Font$ FOR INPUT AS 1        'load font
  52.     CALL    LoadingFont
  53.     LINE INPUT #1,Title$
  54.     LINE INPUT #1,Comment$
  55.     LINE INPUT #1,PrnChar$
  56.     LINE INPUT #1,MARGIN$
  57.     Margin=VAL(Margin$)
  58.     LINE INPUT #1,Spacing$
  59.     Spacing=VAL(Spacing$)
  60.     FOR J=1 TO 95
  61.       LINE INPUT #1,FontChar$(J)
  62.       IF J=1 AND FontChar$(J)<>"" THEN
  63.         FontLen$="space "
  64.       ELSEIF FontChar$(J)<>"" THEN
  65.         FontLen$=FontLen$+CHR$(J+31)+" "
  66.       END IF
  67.       IF EOF(1) THEN
  68.         CLOSE
  69.         GOTO Main
  70.       END IF
  71.     NEXT
  72.     LINE INPUT #1,Init$
  73.     LINE INPUT #1,Reset$
  74.     INPUT #1,HzMult
  75.     INPUT #1,VMult
  76.     INPUT #1,Vdiv
  77.     CLOSE
  78.     IF HzMult=2 THEN
  79.       HzWdth$="Double"
  80.       HColor=12
  81.     ELSEIF HzMult=3 THEN
  82.       HzWdth$="Triple"
  83.       HColor=13
  84.     ELSE
  85.       HzWdth$="Single"
  86.       HzMult=1
  87.       HColor=11
  88.     END IF
  89.     IF VMult=2 THEN
  90.       VWdth$="Double"
  91.       VColor=12
  92.     ELSEIF VMult=3 THEN
  93.       VWdth$="Triple
  94.       VColor=13
  95.     ELSEIF VDiv=2 THEN
  96.       VWdth$="Half  "
  97.       VColor=14
  98.     ELSE
  99.       VWdth$="Single"
  100.       VMult=1
  101.       VDiv=1
  102.       VColor=11
  103.     END IF
  104. Main:            'banner text screen
  105.     CALL    DoTitle
  106.     CALL    GetBanner
  107.     LOCATE 6,1
  108.     PRINT TAB(39-(LEN(Title$)/2)) Title$
  109.     PRINT TAB(39-(LEN(Comment$)/2)) Comment$
  110.     LOCATE 12,1
  111.     FOR I=1 TO 133 STEP 66
  112.       IF LEN(FontLen$)>I THEN
  113.         PRINT TAB(7) MID$(FontLen$,I,65)
  114.       END IF
  115.     NEXT
  116.     LOCATE 23,15,1
  117.     LINE INPUT Txt$
  118.     IF Txt$="" THEN
  119. OptionMenu:        'option menu screen
  120.       IF PrnChar$<CHR$(127) AND PrnChar$>" " THEN
  121.         PC$=" "+PrnChar$+" -"+STR$(ASC(PrnChar$))+" decimal"
  122.       ELSEIF PrnChar$=CHR$(255) THEN
  123.         PC$=" Variable"
  124.       ELSE
  125.         PC$=STR$(ASC(PrnChar$))+" decimal"
  126.       END IF
  127.       CALL    OptionMenu
  128.       LOCATE 5,52
  129.       PRINT Font$;
  130.       LOCATE 7,52
  131.       PRINT"Column";Margin;
  132.       LOCATE 9,51
  133.       PRINT PC$;
  134.       LOCATE 11,51
  135.       PRINT Spacing;"rows";
  136.       LOCATE 13,52
  137.       COLOR HColor,0
  138.       PRINT HzWdth$;
  139.       LOCATE 15,52
  140.       COLOR VColor,0
  141.       PRINT VWdth$;
  142.       LOCATE 18,52
  143.       IF NotSaved THEN
  144.         LOCATE 19,52
  145.         COLOR 12,0
  146.         PRINT"Not Saved";
  147.       END IF
  148.       COLOR 11,0
  149.       LOCATE 24,22,1
  150. GetOption:
  151.       Opt$=INPUT$(1)
  152.       Done=0
  153.  
  154.       IF Opt$=CHR$(3) THEN
  155.         GOTO Finish
  156.  
  157.       ELSEIF Opt$<" " THEN
  158.         GOTO Main
  159.  
  160.       ELSEIF Opt$="1" THEN
  161.         GOTO FontScreen
  162.  
  163.       ELSEIF Opt$="2" THEN    'set left margin
  164.         WHILE NOT Done
  165.           BadString=0
  166.           CALL        OptionScr2
  167.           LOCATE 8,53
  168.           PRINT Margin;
  169.           LOCATE 23,36,1
  170.           LINE INPUT;Margin$
  171.           IF Margin$<>"" THEN
  172.             FOR I=1 TO LEN(Margin$)
  173.               Byte$=MID$(Margin$,I,1)
  174.               IF Byte$<"0" OR Byte$>"9" OR I>3 THEN
  175.             BEEP
  176.             BadString=-1
  177.               END IF
  178.             NEXT
  179.             IF NOT BadString THEN
  180.               Margin=VAL(Margin$)
  181.               IF Margin>230 THEN
  182.             BEEP
  183.               ELSE
  184.             NotSaved=-1
  185.             Done=-1
  186.               END IF
  187.             END IF
  188.           ELSE
  189.             Done=-1
  190.           END IF
  191.         WEND
  192.  
  193.       ELSEIF Opt$="3" THEN     'set print character
  194.         WHILE NOT Done
  195.           BadChar=0
  196.           CALL        OptionScr3
  197.           LOCATE 6,46,0
  198.           PRINT PC$;
  199.           LOCATE 24,30,1
  200.           LINE INPUT;NewPrnChar$
  201.           IF LEN(NewPrnChar$)>3 THEN
  202.             BEEP
  203.           ELSEIF LEN(NewPrnChar$)>1 THEN
  204.             FOR I=1 TO LEN(NewPrnChar$)
  205.               IF MID$(NewPrnChar$,I,1)<"0"_
  206.               OR MID$(NewPrnChar$,I,1)>"9" THEN
  207.             BEEP
  208.             BadChar=-1
  209.               END IF
  210.             NEXT
  211.             IF VAL(NewPrnChar$)<256 AND NOT BadChar THEN
  212.           PrnChar$=CHR$(VAL(NewPrnChar$))
  213.           Done=-1
  214.           NotSaved=-1
  215.             ELSE
  216.               BEEP
  217.             END IF
  218.           ELSEIF LEN(NewPrnChar$)=1 THEN
  219.             PrnChar$=NewPrnChar$
  220.             Done=-1
  221.             NotSaved=-1
  222.           ELSE
  223.             Done=-1
  224.           END IF
  225.         WEND
  226.  
  227.       ELSEIF Opt$="4" THEN     'set rows between characters
  228.         WHILE NOT Done
  229.           CALL        OptionScr4
  230.           LOCATE 9,45
  231.           PRINT Spacing
  232.           LOCATE 24,18,1
  233.           LINE INPUT;Spacing$
  234.           IF Spacing$="" THEN
  235.             Done=-1
  236.           ELSEIF LEN(Spacing$)<3 THEN
  237.             Spacing=VAL(Spacing$)
  238.             NotSaved=-1
  239.             Done=-1
  240.           ELSE
  241.             BEEP
  242.           END IF
  243.         WEND
  244.  
  245.       ELSEIF Opt$="5" THEN    'toggle print width
  246.         IF HzMult=3 THEN
  247.           HzWdth$="Single"
  248.           HzMult=1
  249.           HColor=11
  250.         ELSEIF HzMult=1 THEN
  251.           HzWdth$="Double"
  252.           HzMult=2
  253.           HColor=12
  254.         ELSE
  255.           HzWdth$="Triple"
  256.           HzMult=3
  257.           HColor=13
  258.         END IF
  259.         LOCATE 13,52
  260.         COLOR HColor,0
  261.         PRINT HzWdth$
  262.         COLOR 11,0
  263.         LOCATE 24,22,1
  264.         GOTO GetOption
  265.  
  266.       ELSEIF Opt$="6" THEN    'toggle print height
  267.         IF VDiv=2 THEN
  268.           VWdth$="Single"
  269.           VColor=11
  270.           Vdiv=1
  271.         ELSEIF VMult=1 THEN
  272.           VWdth$="Double"
  273.           VMult=2
  274.           VColor=12
  275.         ELSEIF VMult=2 THEN
  276.           VWdth$="Triple"
  277.           VMult=3
  278.           VColor=13
  279.         ELSE
  280.           VWdth$="Half  "
  281.           VMult=1
  282.           VDiv=2
  283.           VColor=14
  284.         END IF
  285.         LOCATE 15,52
  286.         COLOR VColor,0
  287.         PRINT VWdth$
  288.         COLOR 11,0
  289.         LOCATE 24,22,1
  290.         GOTO GetOption
  291.  
  292.       ELSEIF Opt$="7" THEN    'set printer initialization & reset strings
  293.         CALL    OptionScr7
  294.         GOSUB InitSet
  295.         IF DEC$="999" THEN
  296.           Init$=""
  297.           NotSaved=-1
  298.         ELSEIF PRNINIT$<>"" THEN
  299.           Init$=PrnInit$
  300.           NotSaved=-1
  301.         END IF
  302.         CALL    OptionScr7a
  303.         GOSUB InitSet
  304.         IF DEC$="999" THEN
  305.           Reset$=""
  306.           NotSaved=-1
  307.         ELSEIF PrnInit$<>"" THEN
  308.           Reset$=PrnInit$
  309.           NotSaved=-1
  310.         END IF
  311.  
  312.       ELSEIF Opt$="8" THEN    'save changes to disk
  313.         CALL    OptionScr8
  314.         FontBak$=LEFT$(Font$,INSTR(Font$,"."))+"BAK"
  315. 2100        OPEN FontBak$ FOR INPUT AS 1    'see if <fontname>.BAK exists
  316.         CLOSE #1        'close, if found, else error trap gets it
  317.         LOCATE 8,20
  318.         PRINT"Erasing  ";FontBak$
  319.         KILL FontBak$
  320. NewBakFile:
  321.         LOCATE 10,20
  322.         PRINT"Changing ";Font$;" to ";FontBak$
  323.         NAME Font$ AS FontBak$
  324.         LOCATE 12,20
  325.         PRINT"Writing  ";Font$
  326.         OPEN Font$ FOR OUTPUT AS 1
  327.         PRINT #1,Title$
  328.         PRINT #1,Comment$
  329.         PRINT #1,PrnChar$
  330.         PRINT #1,Margin$
  331.         PRINT #1,Spacing$
  332.         FOR J=1 TO 95
  333.           PRINT #1,FontChar$(J)
  334.         NEXT
  335.         PRINT #1,Init$
  336.         PRINT #1,Reset$
  337.         PRINT #1,HzMult
  338.         PRINT #1,VMult
  339.         PRINT #1,Vdiv
  340.         CLOSE
  341.         NotSaved=0
  342.  
  343.       ELSE
  344.         GOTO GetOption
  345.       END IF
  346.  
  347.       GOTO OptionMenu
  348.     END IF
  349. DoBanner:
  350.     PRINT"Sending ====> ";
  351.     LPRINT Init$            'printer initialization string
  352.     FOR I=1 TO LEN(Txt$)
  353.       Char=ASC(MID$(Txt$,I,1))-31
  354.       IF FontChar$(Char)="" THEN    'no lower case in font?
  355.         IF Char>65 AND Char<92 THEN
  356.           CHAR=CHAR-32        'then use upper, if available
  357.         END IF
  358.       END IF
  359.       IF Char>0 THEN
  360.         PRINT MID$(Txt$,I,1);
  361.         IF PrnChar$=CHR$(255) THEN
  362.           PChar$=CHR$(31+Char)
  363.         ELSE
  364.           PChar$=PrnChar$
  365.         END IF
  366.         ArrLen=LEN(FontChar$(Char))
  367.         IF ArrLen>0 THEN
  368.           FOR Byte=1 TO ArrLen STEP 2
  369.             Quit$=INKEY$
  370.             IF Quit$=CHR$(27) OR Quit$=CHR$(3) THEN
  371.               LPRINT Reset$
  372.               GOTO Main
  373.             END IF
  374.             LineFlag=0
  375.             IF MID$(FontChar$(Char),Byte,1)=CHR$(255) THEN
  376.               FOR J=1 TO HzMult
  377.             LPRINT
  378.               NEXT
  379.               Byte=Byte-1
  380.             ELSE
  381.               Segment=Segment+1
  382.               Column=ASC(MID$(FontChar$(Char),Byte,1))+Margin-31
  383.               Length=ASC(MID$(FontChar$(Char),Byte+1,1))-32
  384.               IF Length>95 THEN
  385.             Length=Length-128
  386.             LineFlag=-1
  387.               END IF
  388.               LPRINT TAB((Column*VMult)/VDiv)_
  389.               STRING$((Length*VMult)/VDiv,PChar$);
  390.               IF LineFlag THEN
  391.             LPRINT
  392.             NumRows=NumRows+1
  393.             IF NumRows<HzMult THEN
  394.               Byte=Byte-(Segment*2)
  395.             ELSE
  396.               NumRows=0
  397.             END IF
  398.             Segment=0
  399.               END IF
  400.             END IF
  401.           NEXT
  402.           IF Spacing>0 THEN
  403.             LPRINT STRING$(Spacing,10);
  404.           END IF
  405.         END IF
  406.       END IF
  407.     NEXT
  408.     LPRINT Reset$    'printer reset string
  409.     GOTO Main
  410.  
  411. Finish:
  412.     CLS
  413.     END
  414.  
  415. InitSet:    'enter printer initialization or reset strings
  416.     K=0
  417.     CALL    OptionScr7b
  418.     PrnInit$=""
  419.     Dec$="0"
  420.     ' define scroll window in assembly values
  421.     ULCorner=&H0E00        'row 14 col 0
  422.     LRCorner=&H174F        'row 23 col 79
  423.     WHILE Dec$<>"" AND Dec$<>"999"
  424.       BadVal=0
  425.       K=K+1
  426.       LOCATE 24,1
  427.       PRINT"Decimal value for byte #";K;": ";
  428.       LINE INPUT;Dec$
  429.       CALL    WindowScroll (ULCorner,LRCorner)
  430.       IF LEN(Dec$)>3 THEN
  431.         BEEP
  432.         BadVal=-1
  433.         K=K-1
  434.       ELSEIF Dec$<>"" THEN
  435.             FOR J=1 TO LEN(Dec$)
  436.           IF MID$(Dec$,J,1)<"0" OR MID$(Dec$,J,1)>"9" THEN
  437.             BEEP
  438.             J=LEN(Dec$)
  439.             BadVal=-1
  440.             K=K-1
  441.           END IF
  442.         NEXT
  443.         IF Dec$="999" THEN
  444.           PrnInit$=""
  445.         ELSEIF VAL(Dec$)>255 THEN
  446.           BEEP
  447.           K=K-1
  448.         ELSEIF NOT BadVal THEN
  449.           PrnInit$=PrnInit$+CHR$(VAL(Dec$))
  450.         END IF
  451.       END IF
  452.     WEND
  453.     'a bare return retains the old string
  454.     RETURN
  455.  
  456. ErrorTrap:
  457.     CLOSE
  458.     IF ERR=53 AND ERL=2100 THEN
  459.       RESUME NewBakFile
  460.     END IF
  461.     IF ERR=53 AND ERL=500 THEN
  462.       ErrorMes$=Font$+" not found - try again"
  463.     ELSEIF ERR=76 AND ERL=500 THEN
  464.       ErrorMes$="Path"+" not found - try again"
  465.     ELSEIF ERR=53 AND ERL=400 THEN
  466.       ErrorMes$="No fonts found on "+Font$
  467.     ELSEIF ERR=64 OR ERR=52 THEN
  468.       ErrorMes$=CHR$(34)+Font$+CHR$(34)+_
  469.           " is a bad file name or drive - try again"
  470.     ELSE
  471.       ON ERROR GOTO 0
  472.     END IF
  473.     RESUME FontScreen
  474.